home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d2
/
uneedit.arc
/
SYSID32.ARC
/
SYSID.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-12-17
|
54KB
|
1,446 lines
(*
** SYSID.PAS
** Version 3.2
**
** Usage: [d:][path]SYSID
**
** A system description for DOS-based PC/XT/AT- and PS/2-class machines.
** SYSID generates 12 screens of information about the host system and runs
** under DOS versions 3.0 and later.
**
** My primary source of ideas in SYSID was Ray Duncan's book Advanced MS-DOS.
** Terje Mathisen supplied the DISKREAD function. The CPUID object module is
** largely and shamelessly stolen from Bob Smith's article "Chips in
** Transition" (PC Tech Journal 4:4 p.56).
**
** Some of the techniques SYSID uses are not documented or officially
** supported by either IBM or Microsoft. Where possible I have followed the
** undocumented routine with a comment describing my source for the
** technique.
**
** SYSID was developed on an IBM PC with Turbo Pascal version 4.0 and DOS
** version 3.30. The source code has been split into two files: SYSID.PAS
** (this file) and an include file, SYSID.INC, which contains all function
** and procedure declarations. (The original single source file simply
** outgrew the capacity of the Turbo Pascal editor.) The CPUID object module
** was developed with the WordPerfect Library Program Editor version 4.1 and
** the Microsoft Macro Assembler version 3.0.
**
** Known bugs:
** 1) The PS/2 Model 80 on which I tested SYSID inexplicably choked on the
** CPUID external assembly language procedure.
** 2) Page 1: On some machines with an 80286 CPU the CPUID module
** mistakenly identifies the CPU as a NEC V30.
** 3) Page 4: The Compaq Deskpro 386 on which I tested SYSID sometimes,
** but not always, choked on the "Scan lines/character" item.
** 4) Page 5: The description of foreground color will not mention the
** blinking attribute, even if it was enabled before you invoked SYSID.
** 5) Page 6: SYSID may report that you have no mouse when in fact you do.
** SYSID relies on INT 51H for its mouse information, but some mouse
** device drivers (Logitech's MOUSE.SYS, for example) don't use INT 51H.
** (On page 9 SYSID will always find the mouse's device driver if one is
** loaded.) Does the PC Magazine article on which this section is based
** have any basis in fact?
** 6) Page 8: SYSID used to report incorrectly the statuses of some of the
** the executable files which use the "multiplex interrupt" (INT 2FH).
** I have commented these status checks out of the source code,
** determined to do battle with them another day. Can anyone supply the
** correct INT 2FH functions for these files? Or are some of them red
** herrings that simply check INT 2FH to see if *other* files have been
** loaded (e.g. APPEND/ASSIGN)?
** 7) Page 12: The speaker doesn't always beep the first time you hit
** <PgDn>. Similarly, you won't always get beeped when you hit <PgUp>
** when you're on page 1. This seems to be an idiosyncrasy of Turbo
** Pascal, not SYSID.
**
** Both the source and object code of SYSID are hereby released into the
** public domain. Neither version carries any warranty, expressed or
** implied, of merchantability or fitness for a particular purpose.
**
** Comments, suggestions, and questions may be addressed to:
** BIXMail: sjgrant
** CompuServe: 71101,706
**
** Steve Grant
** Long Beach, CA
** July 8, 1988
*)
(*$B-*)
(*$D-*)
(*$F-*)
(*$I-*)
(*$L+*)
(*$M 16384, 0, 655360*)
(*$N-*)
(*$R-*)
(*$S-*)
(*$T+*)
(*$V-*)
program SYSID;
uses
crt,
dos,
graph;
const
BIOSext = $AA55;
BIOSseg = $0040;
cassetteint = $15;
EGAseg = $C000;
EMMint = $67;
filesmax = 256;
HDCseg = $C800;
mouseint = $51;
nuldev = 'NUL ';
PCROMseg = $F000;
pgmax = 12;
pchar1 : set of char = [#9, #10, #13, ' '..'~'];
pchar2 : set of char = [' '..'~'];
qEMMdrvr = 'EMMXXXX0';
qhexpref = '$';
qindent = ' ';
qspace2 = ' ';
qspace3 = ' ';
qspace4 = ' ';
qspace7 = ' ';
qversion = 'Version 3.2';
secsiz1 = 511;
strmax = 255;
tickrate = 55;
type
str4 = string[4];
str9 = string[9];
str19 = string[19];
var
attrsave : byte;
bootrec : array[0..secsiz1] of byte;
bootstat : word;
ccode : word;
country : array[0..33] of byte;
cpuword : word;
currdrv : byte;
devofs : word;
devseg : word;
DOScofs : word;
DOScseg : word;
dosmem : longint;
EGABIOS1 : word;
EGABIOS2 : word;
EMMarray : array[$000..$3FF] of word;
equip : word;
f : array[1..filesmax] of file;
graphdriver : integer;
graphmode : integer;
HDCBIOS1 : word;
HDCBIOS2 : word;
header : array[0..17] of byte;
i : word;
intofs : array[$00..$FF] of word;
intseg : array[$00..$FF] of word;
j : word;
lqindent : byte;
osmajor : byte;
osminor : byte;
PCBIOS1 : word;
PCBIOS2 : word;
pg : 1..pgmax;
regs : registers;
search : searchrec;
strunk : str9;
tlength : byte;
topline : byte;
twidth : byte;
vidpg : byte;
x1 : byte;
x2 : byte;
xbool1 : boolean;
xbool2 : boolean;
xbool3 : boolean;
xbyte1 : byte;
xbyte2 : byte;
xchar1 : char;
xchar2 : char;
xint1 : integer;
xint2 : integer;
xlongint : longint;
xstring : string;
xword1 : word;
xword2 : word;
xword3 : word;
xword4 : word;
xword5 : word;
(*$I SYSID.INC *)
begin
with regs do begin
AH := $30;
MSDOS(regs);
osmajor := AL;
osminor := AH;
if osmajor >= 3 then begin
attrsave := textattr;
cpuword := cpuid;
detectgraph(graphdriver, graphmode);
(* BIX ms.dos/secrets #1322 *)
if (graphdriver = EGA) or (graphdriver = VGA) then
tlength := mem[BIOSseg : $0084] + 1
else
tlength := 25;
AH := $0F;
intr($10, regs);
twidth := AH;
vidpg := BH;
write('Working...');
strunk := '(unknown)'#0;
if BIOSscan(PCROMseg, $E000, $FFFF, xword1) then begin
PCBIOS1 := PCROMseg;
PCBIOS2 := xword1
end else
BIOSunk(PCBIOS1, PCBIOS2);
intr($11, regs);
equip := AX;
(* Byte 12:12 p.178 *)
intr($12, regs);
dosmem := $400 * longint(AX);
AX := $5200;
MSDOS(regs);
devseg := ES;
devofs := BX;
for i := $00 to $FF do begin
AH := $35;
AL := i;
MSDOS(regs);
intseg[i] := ES;
intofs[i] := BX;
end;
(* BIX ms.dos/secrets #1032 *)
if graphdriver = EGA then
if (memw[EGAseg : $0000] = BIOSext)
and BIOSscan(EGAseg, $0002, $3FFF, xword1) then begin
EGABIOS1 := EGAseg;
EGABIOS2 := xword1
end else
BIOSunk(EGABIOS1, EGABIOS2);
AX := $3400;
MSDOS(regs);
DOScseg := ES;
DOScofs := BX;
(* BIX ms.dos/secrets #2 *)
AX := $3800;
DS := seg(country);
DX := ofs(country);
MSDOS(regs);
ccode := BX;
AH := $19;
MSDOS(regs);
currdrv := AL;
i := 0;
xword1 := HDCseg;
xbool2 := false;
repeat
if (memw[xword1 : $0000] = BIOSext)
and BIOSscan(xword1, $0002, $1FFF, xword2) then begin
xbool2 := true;
HDCBIOS1 := xword1;
HDCBIOS2 := xword2
end else if i < 3 then begin
inc(i);
inc(xword1, $0200)
end else begin
xbool2 := true;
BIOSunk(HDCBIOS1, HDCBIOS2)
end
until xbool2;
bootstat := diskread(currdrv, 0, 1, bootrec);
textbackground(black);
window(1, 1, twidth, tlength);
clrscr;
textcolor(green);
write('SYSID');
textcolor(lightgray);
write(' - System description for IBM PC''s and compatibles');
rjustify(qversion);
writeln;
border;
gotoxy(1, tlength - 1);
border;
writeln;
write('Page ');
x1 := wherex;
write(pgmax, ' of ', pgmax);
textcolor(green);
rjustify('PgDn PgUp Home End Esc');
x2 := wherex;
pg := 1;
lqindent := length(qindent);
xbool1 := false;
repeat
gotoxy(x1, tlength);
textcolor(lightgray);
write(pg : 2);
window(1, 3, twidth, tlength - 2);
clrscr;
case pg of
1 : begin
caption2('Machine type');
xbool2 := true;
if intinit(cassetteint) then begin
AH := $C0;
intr(cassetteint, regs);
if nocarry then begin
xbool2 := false;
xword1 := memw[ES : BX + 2];
if xword1 = $01FC then
writeln('PC-AT 3x9')
else if xword1 = $01FB then
writeln('PC-XT/2')
else if xword1 = $02FC then
writeln('PC-XT/286')
else if xword1 = $00F9 then
writeln('PC-Convertible')
else if xword1 = $00FA then
writeln('PS/2 Model 30')
else if xword1 = $04FC then
writeln('PS/2 Model 50')
else if xword1 = $05FC then
writeln('PS/2 Model 60')
else if xword1 = $00F8 then
writeln('PS/2 Model 80')
else if xword1 = $00FC then
writeln('7531/2 Industrial AT')
else if xword1 = $06FC then
writeln('7552 Gearbox')
else
unknown('machine - model/type word', xword1, 4);
caption2(qindent + 'BIOS revision level');
writeln(mem[ES : BX + 4]);
caption2(qindent + 'Hardware configuration');
writeln(bin8(mem[ES : BX + 5]))
end
end;
if xbool2 then begin
xbyte1 := mem[$FFFF : $000E];
case xbyte1 of
$FF : writeln('PC');
$FE : writeln('PC-XT');
$FD : writeln('PCjr');
$FC : writeln('PC-AT')
else
unknown('machine - model byte', xbyte1, 2)
end
end;
(* Byte 12:12 p. 174 *)
caption2('BIOS source');
showBIOS(PCBIOS1, PCBIOS2);
caption2('BIOS date');
xstring := '';
i := 0;
xbool2 := false;
repeat
if i < strmax then begin
xchar1 := chr(mem[$FFFF : $0005 + i]);
if xchar1 in pchar2 then begin
xstring := xstring + xchar1;
inc(i)
end else
xbool2 := true
end else
xbool2 := true;
until xbool2;
if i > 7 then
writeln(xstring)
else
dontknow;
caption2('CPU');
xbyte1 := hi(cpuword);
case xbyte1 of
$00 : writeln('NEC V20');
$01 : writeln('NEC V30');
$07 : writeln('Intel 80286 or 80386');
$08 : writeln('Intel 8088');
$09 : writeln('Intel 8086');
$0A : writeln('Intel 80188');
$0B : writeln('Intel 80186');
$0F : writeln('Intel 80286')
else
unknown('CPU ID byte', xbyte1, 2);
end;
caption1(qindent + 'Interrupts ');
if (xbyte1 and $08) = $00 then
write('do not ');
write('corrupt');
caption1(' multi-prefix string instructions');
writeln;
caption1(qindent + 'PUSH SP ');
if (xbyte1 and $04) = $04 then
write('writes, then decrements')
else
write('decrements, then writes');
caption1(' SP');
writeln;
caption1(qindent + 'Shift instructions use ');
if (xbyte1 and $02) = $02 then
write('only lower 5')
else
write('all 8');
caption1(' bits of second register operand');
writeln;
caption1(qindent + 'Prefetch instruction queue is ');
if (xbyte1 and $01) = $01 then
write('6')
else
write('4');
caption1(' bytes');
writeln;
caption2('Coprocessor present');
xbyte1 := lo(cpuword);
case xbyte1 of
$00 : writeln('no');
$01 : writeln('8087');
$02 : writeln('80287')
else
unknown('coprocessor type', xbyte1, 2)
end;
caption2('Coprocessor enabled');
yesorno(equip and $0002 = $0002);
writeln;
caption2('DMA installed (PCjr)');
yesorno(equip and $0100 = $0000)
end;
2 : begin
caption2('Total conventional memory (bytes)');
writeln(dosmem : 6);
caption2('Free conventional memory (bytes) ');
writeln(dosmem - $10 * longint(prefixseg) : 6);
caption2('Extended memory (bytes) ');
if intinit(cassetteint) then begin
AH := $88;
intr(cassetteint, regs);
if nocarry then
writeln($400 * longint(AX) : 8)
else
writeln('N/A' : 8);
end else
writeln('N/A' : 8);
caption2('Expanded memory');
if intinit(EMMint) then begin
writeln;
caption2(qindent + 'Interrupt vector');
Xword1 := intseg[EMMint];
segofs(xword1, intofs[EMMint]);
writeln;
caption2(qindent + 'Driver');
xstring := '';
for i := $000A to $0011 do
xstring := xstring + showchar(chr(mem[xword1 : i]));
write(xstring);
if xstring = qEMMdrvr then begin
writeln;
caption2(qindent + 'Manager status');
AH := $40;
intr(EMMint, regs);
if AH = $00 then
writeln('OK')
else
EMMerr(AH);
caption2(qindent + 'Page frame segment');
AH := $41;
intr(EMMint, regs);
if AH = $00 then
writeln(hex(BX, 4))
else
EMMerr(AH);
caption2(qindent + 'Total EMS memory (16K pages)');
AH := $42;
intr(EMMint, regs);
if AH = $00 then
writeln(DX : 3)
else
EMMerr(AH);
caption2(qindent + 'Free EMS memory (16K pages) ');
if AH = $00 then
writeln(BX : 3)
else
EMMerr(AH);
caption2(qindent + 'EMM version');
AH := $46;
intr(EMMint, regs);
if AH = $00 then
writeln(AL shr 4, '.', AL and $0F)
else
EMMerr(AH);
caption1(qindent + 'Handle' + qspace3 + '16K pages');
writeln;
AH := $4D;
ES := seg(EMMarray);
DI := ofs(EMMarray);
intr(EMMint, regs);
if AH = $00 then
if BX > $0000 then begin
topline:= 15;
window(1 + lqindent, topline, twidth, tlength - 2);
for i := 1 to BX do begin
pause;
writeln(hex(EMMarray[2 * i - 2], 4), ' ', qspace3
, EMMarray[2 * i - 1] : 3)
end
end else
writeln(qindent, '(no active handles)')
else
EMMerr(AH)
end else
writeln(' (unknown driver)')
end else
writeln('(none)')
end;
3 : begin
caption1('MCB ' + qspace3 + 'PSP ' + qspace3 + 'Parent' + qspace3
+ ' Size' + qspace3 + 'Owner ' + qspace3 + 'Interrupts');
writeln;
topline := 4;
window(1, topline, twidth, tlength - 2);
xword1 := memw[devseg : devofs - $02];
(* BIX ms.dos/secrets #1032 *)
xbool2 := false;
repeat
xbyte1 := mem[xword1 : $0000];
xword2 := memw[xword1 : $0001];
xword3 := memw[xword2 : $0016];
pause;
case xbyte1 of
$4D : begin
xword4 := memw[xword1 : $0003];
showMCB(xword1, xword2, xword3, xword4);
inc(xword1, 1 + xword4)
end;
$5A : begin
xword4 := dosmem shr 4 - xword1 - 1;
showMCB(xword1, xword2, xword3, xword4);
xbool2 := true
end else begin
unknown('MCB status', xbyte1, 2);
xbool2 := true
end
end
until xbool2
end;
(* PC Magazine 6:14 p.425 *)
4 : begin
caption2('Display adapter');
case graphdriver of
CGA : writeln('CGA');
MCGA : writeln('MCGA');
EGA..EGAmono : begin
writeln('EGA');
caption2(qindent + 'BIOS source');
showBIOS(EGABIOS1, EGABIOS2);
xbyte1 := mem[BIOSseg : $0087];
caption1(qindent + 'Screen buffer ');
if (xbyte1 and $80) = $00 then
write('cleared')
else
write('preserved');
caption1(' during last mode change');
writeln;
caption2(qindent + 'Memory');
case xbyte1 and $60 of
$00 : writeln('64K');
$20 : writeln('128K');
$40 : writeln('192K');
$60 : writeln('256K')
end;
caption2(qindent + 'EGA active');
yesorno(xbyte1 and $08 = $00);
writeln;
caption2(qindent + 'Wait for display enable');
yesorno(xbyte1 and $04 = $04);
writeln;
caption2(qindent + 'Attached display');
if (xbyte1 and $02) = $00 then
writeln('color')
else
writeln('monochrome');
caption2(qindent + 'CGA cursor emulation');
yesorno(xbyte1 and $01 = $00);
writeln;
(* PC Magazine 6:12 p.326 *)
caption2(qindent + 'Scan lines/character');
AX := $1130;
intr($10, regs);
writeln(CX);
(* PC Magazine 6:17 p.424 *)
xbyte1 := mem[BIOSseg : $0088];
caption2(qindent + 'Feature bits');
writeln(bin4(xbyte1 shr 4));
caption2(qindent + 'DIP switches');
writeln(bin4(xbyte1 and $0F));
(* PC Tech Journal 3:4 p.65 *)
xword1 := memw[BIOSseg : $00AA];
xword2 := memw[BIOSseg : $00A8];
caption2(qindent + 'Save area ');
segofs(xword1, xword2);
writeln;
(* PC Tech Journal 3:4 p.65 *)
caption2(qindent + 'Video parameter table ');
segofs(memw[xword1 : xword2 + 2], memw[xword1 : xword2]);
writeln;
caption2(qindent + 'Dynamic save area ');
xword3 := memw[xword1 : xword2 + 6];
xword4 := memw[xword1 : xword2 + 4];
if (xword3 > $0000) or (xword4 > $0000) then begin
segofs(xword3, xword4);
writeln
end else
writeln('(none)');
caption2(qindent + 'Auxiliary character generator');
xword3 := memw[xword1 : xword2 + 10];
xword4 := memw[xword1 : xword2 + 8];
if (xword3 > $0000) or (xword4 > $0000) then begin
segofs(xword3, xword4);
writeln
end else
writeln('(none)');
caption2(qindent + 'Graphics mode auxiliary table');
xword3 := memw[xword1 : xword2 + 14];
xword4 := memw[xword1 : xword2 + 12];
if (xword3 > $0000) or (xword4 > $0000) then begin
segofs(xword3, xword4);
writeln
end else
writeln('(none)')
(* PC Tech Journal 3:4 p.67 *)
end;
hercmono : writeln('Hercules or MDA');
ATT400 : writeln('AT&T 400');
VGA : begin
writeln('VGA');
caption2(qindent + 'Active display');
case BL of
$07 : writeln('analog monochrome');
$08 : writeln('analog color')
else
unknown('display type', BL, 2)
end
end;
(* PC Magazine 6:19 p.480 *)
PC3270 : writeln('3270 PC')
else
unknown('adapter', graphdriver, 4)
end
end;
5 : begin
caption2('Initial video mode');
case equip and $30 of
$00 : writeln('No display');
$10 : writeln('40 x 25 color');
$20 : writeln('80 x 25 color');
$30 : writeln('80 x 25 monochrome')
end;
caption2('Current video mode');
xbyte1 := lo(lastmode);
write(xbyte1, ' ');
case xbyte1 of
0 : writeln('(40 x 25 b/w text)');
1 : writeln('(40 x 25 color text)');
2 : writeln('(80 x 25 b/w text)');
3 : writeln('(80 x 25 color text)');
4 : writeln('(320 x 200 4 colors)');
5 : writeln('(320 x 200 4 colors, no color burst)');
6 : writeln('(640 x 200 2 colors)');
7 : writeln('(MDA text)');
8 : writeln('(160 x 200 16 colors)');
9 : writeln('(320 x 200 16 colors)');
10 : writeln('(640 x 200 4 colors)');
13 : writeln('(320 x 200 16 colors)');
14 : writeln('(640 x 200 16 colors)');
15 : writeln('(640 x 350 monochrome)');
16 : writeln('(640 x 350 16 colors)');
17 : writeln('(640 x 480 2 colors)');
18 : writeln('(640 x 480 16 colors)');
19 : writeln('(640 x 480 256 colors)')
else
unknown('video mode', xbyte1, 2)
end;
(* Byte 12:12 p. 176D *)
caption2('Valid graphics modes');
getmoderange(graphdriver, xint1, xint2);
writeln(xint1, '-', xint2);
caption2('Video buffer (offset)');
writeln(hex(memw[BIOSseg : $004E], 4));
(* PC Magazine 6:8 p.290 *)
caption2('Video buffer size (bytes)');
writeln(memw[BIOSseg : $004C]);
(* PC Magazine 6:8 p.290 *)
caption2('Active display port');
xword1 := memw[BIOSseg : $0063];
write(qhexpref, hex(xword1, 3), ' ');
if xword1 = $3B4 then
writeln('(monochrome)')
else if xword1 = $3D4 then
writeln('(color)')
else
dontknow;
(* PC Magazine 6:8 p.290 *)
caption2('CRT mode register');
writeln(qhexpref, hex(mem[BIOSseg : $0065], 2));
(* PC Magazine 6:8 p.290 *)
caption2('Current palette');
writeln(qhexpref, hex(mem[BIOSseg : $0066], 2), qindent);
(* PC Magazine 6:8 p.290 *)
caption2('Colors');
caption1('·');
for i := black to white do begin
textcolor(i);
write('█')
end;
caption1('·');
writeln;
caption2('Current display page');
writeln(vidpg);
caption2('Text rows ');
writeln(tlength);
caption2('Text columns');
writeln(twidth);
caption2('Current colors');
if (attrsave and $80) = $80 then
write('blinking ');
showcolor(attrsave and $0F);
write(' on ');
showcolor(attrsave and $70 shr 4);
writeln;
caption2('Cursor scan lines');
AH := $03;
BH := vidpg;
intr($10, regs);
writeln(CH, '-', CL)
end;
6 : begin
caption2('Keyboard');
writeln;
AH := $02;
intr($16, regs);
caption2(qindent + 'Insert');
offoron(AL and $80);
caption2(qspace7 + 'Caps Lock');
offoron(AL and $40);
caption2(qspace7 + 'Num Lock');
offoron(AL and $20);
caption2(qspace7 + 'Scroll Lock');
offoron(AL and $10);
writeln;
caption2(qindent + 'Buffer');
xword1 := memw[BIOSseg : $0080];
segofs(BIOSseg, xword1);
xword2 := memw[BIOSseg : $0082];
writeln('-', hex(xword2, 4));
(* PC Magazine 6:8 p.290 *)
caption2(qindent + 'Buffer size (keystrokes)');
writeln((xword2 - xword1) shr 1 - 1);
caption2(qindent + 'BIOS support for enhanced keyboard');
AH := $02;
intr($16, regs);
xbyte1 := AL;
AX := $1200 + xbyte1 xor $FF;
intr($16, regs);
if AL = xbyte1 then begin
writeln('yes');
caption2(qindent + 'Enhanced keyboard present');
yesorno(mem[BIOSseg : $0096] and $10 = $10);
writeln
end else
writeln('no');
(* PC Magazine 6:15 p.378 *)
caption2('Printers');
xbyte1 := equip and $C000 shr 14;
writeln(xbyte1);
if xbyte1 > 0 then begin
if xbyte1 > 3 then
xbyte1 := 3;
caption1(qindent + 'Device' + qspace2 + 'Addr' + qspace2
+ 'Timeout' + qspace2 + 'Busy' + qspace2 + 'Ack' + qspace2
+ 'Paper out' + qspace2 + 'Selected' + qspace2+ 'I/O error'
+ qspace2 + 'Timed out');
writeln;
for i := 1 to xbyte1 do begin
write(qindent, 'LPT', i, ' ', qspace2, qhexpref
, hex(memw[BIOSseg : 2 * i + 6], 3), qspace2
, mem[BIOSseg : $0077 + i] : 3, ' ', qspace2);
AH := $02;
DX := i - 1;
intr($17, regs);
yesorno(AH and $80 = $00);
write(' ', qspace2);
yesorno(AH and $40 = $40);
write(qspace2);
yesorno(AH and $20 = $20);
write(' ', qspace2);
yesorno(AH and $10 = $10);
write(' ', qspace2);
yesorno(AH and $08 = $08);
write(' ', qspace2);
yesorno(AH and $01 = $01);
writeln
end
end;
(* PC Magazine 6:8 p.290 *)
caption2('Serial ports');
xbyte1 := equip and $0E00 shr 9;
writeln(xbyte1);
if xbyte1 > 0 then begin
if xbyte1 > 4 then
xbyte1 := 4;
caption1(qindent + 'Device' + qspace3 + 'Addr' + qspace3
+ 'Timeout' + qspace3 + 'RLSD' + qspace3 + 'RI ' + qspace3
+ 'DSR' + qspace3 + 'CTS' + qspace3 + 'dRLSD' + qspace3
+ '-dRI' + qspace3 + 'dDSR' + qspace3 + 'dCTS');
writeln;
for i := 1 to xbyte1 do begin
write(qindent, 'COM', i, ' ', qspace3, qhexpref
, hex(memw[BIOSseg : 2 * i - 2], 3), qspace3
, mem[BIOSseg : $007B + i] : 3, ' ', qspace3);
AH := $03;
DX := i - 1;
intr($14, regs);
yesorno(AL and $80 = $80);
write(' ', qspace3);
yesorno(AL and $40 = $40);
write(qspace3);
yesorno(AL and $20 = $20);
write(qspace3);
yesorno(AL and $10 = $10);
write(qspace3);
yesorno(AL and $08 = $08);
write(' ', qspace3);
yesorno(AL and $04 = $04);
write(' ', qspace3);
yesorno(AL and $02 = $02);
write(' ', qspace3);
yesorno(AL and $01 = $01);
writeln
end
end;
(* PC Magazine 6:8 p.290 *)
caption2('Game port');
yesorno(equip and $1000 = $1000);
writeln;
caption2('Mouse');
if intinit(mouseint) then begin
writeln;
caption2(qindent + 'Interrupt vector');
segofs(intseg[mouseint], intofs[mouseint]);
writeln;
caption2(qindent + 'Status');
AX := 0;
intr(mouseint, regs);
if AX = $FFFF then begin
writeln('present');
caption2(qindent + 'Buttons');
if BX = $0000 then
write(3)
else if BX = $FFFF then
write(2)
else
write('(unknown button count description word', hex(BX, 4)
, ')');
end else if AX = $0000 then
writeln('not present')
else
unknown('status', AX, 4)
end else
writeln('no');
(* PC Magazine 6:13 p.420 *)
caption2('Serial printer (PCjr)');
yesorno(equip and $2000 = $2000);
writeln
end;
7 : begin
window(1, 3, twidth shr 1, tlength - 2);
caption2('DOS version');
showvers;
caption2('System date');
getdate(xword1, xword2, xword3, xword4);
if xword4 = 0 then
write('Sunday')
else if xword4 = 1 then
write('Monday')
else if xword4 = 2 then
write('Tuesday')
else if xword4 = 3 then
write('Wednesday')
else if xword4 = 4 then
write('Thursday')
else if xword4 = 5 then
write('Friday')
else if xword4 = 6 then
write('Saturday')
else
write('(', hex(xword4, 4), ')');
write(', ');
xword5 := cbw(country[1], country[0]);
xchar1 := chr(country[11]);
if xword5 = $0000 then
writeln(xword2, xchar1, xword3, xchar1, xword1)
else if xword5 = $0001 then
writeln(xword3, xchar1, xword2, xchar1, xword1)
else if xword5 = $0002 then
writeln(xword1, xchar1, xword2, xchar1, xword3)
else
writeln(xword2, xchar1, xword3, xchar1, xword1);
caption2('System time');
gettime(xword1, xword2, xword3, xword4);
zeropad(xword1);
write(chr(country[13]));
zeropad(xword2);
write(chr(country[13]));
zeropad(xword3);
write(chr(country[9]));
zeropad(xword4);
writeln;
caption2('Command load paragraph');
writeln(hex(prefixseg, 4));
caption2('Ctrl-C check');
AX := $3300;
MSDOS(regs);
if DL = $00 then
writeln('off')
else if DL = $01 then
writeln('on')
else
unknown('status', DL, 2);
caption2('Disk verify');
AH := $54;
MSDOS(regs);
if AL = $00 then
writeln('off')
else if AL = $01 then
writeln('on')
else
unknown('status', AL, 2);
caption2('Switch prefix character');
AX := $3700;
MSDOS(regs);
writeln(chr(DL));
(* BIX ms.dos/secrets #1130 *)
caption2('\DEV\ prefix for devices');
AX := $3702;
MSDOS(regs);
if DL = $00 then
writeln('required')
else
writeln('optional');
(* BIX ms.dos/secrets #1130 *)
caption2('Reset boot');
xword1 := memw[BIOSseg : $72];
if xword1 = $0000 then
writeln('cold')
else if xword1 = $1234 then
writeln('bypass memory test')
else if xword1 = $4321 then
writeln('preserve memory')
else if xword1 = $5678 then
writeln('system suspended')
else if xword1 = $9ABC then
writeln('manufacturing test mode')
else if xword1 = $ABCD then
writeln('system POST loop mode')
else
unknown('flag', xword1, 4);
(* Byte 12:12 p.178 *)
caption2('DOS busy flag');
segofs(DOScseg, DOScofs);
writeln;
caption2('Printer echo');
case osmajor of
3 : case osminor div 10 of
0 : dontknow;
1..3 : showecho($02AC)
else
dontknow
end else
dontknow
end;
(* BIX ms.dos/secrets #501 *)
caption2('PrtSc status');
xbyte1 := mem[BIOSseg : $0100];
case xbyte1 of
$00 : writeln('ready');
$01 : writeln('busy');
$FF : writeln('error on last PrtSc')
else
unknown('status', xbyte1, 2)
end;
(* PC Magazine 6:20 p.412 *)
caption2('Memory allocation');
AX := $5800;
MSDOS(regs);
if AX = $0000 then
writeln('first fit')
else if AX = $0001 then
writeln('best fit')
else if AX = $0002 then
writeln('last fit')
else
unknown('strategy', AX, 4);
caption2('DOS buffers');
case osmajor of
3 : case osminor div 10 of
0 : showbufs($013F);
1..3 : showbufs($0038)
else
dontknow
end else
dontknow
end;
caption2('File handle table ');
xword1 := memw[prefixseg : $0036];
xword2 := memw[prefixseg : $0034];
segofs(xword1, xword2);
writeln;
caption2('File handle table length');
writeln(mem[prefixseg : $0032] : 3);
caption2('File handles used ');
i := 0;
while mem[xword1 : xword2] < $FF do begin
inc(i);
inc(xword2)
end;
writeln(i : 3);
xstring := 'File handles free ';
findfirst('*.*', archive, search);
if doserror = 0 then begin
i := 0;
xbool2 := false;
repeat
if i < filesmax then begin
assign(f[i + 1], search.name);
reset(f[i + 1]);
if ioresult = 0 then
inc(i)
else begin
xbool2 := true;
caption2(xstring + ' ');
writeln(i : 3)
end
end else begin
xbool2 := true;
caption2(xstring);
dontknow
end
until xbool2;
for j := 1 to i do
close(f[j])
end else begin
caption2(xstring);
dontknow
end;
caption2('Global code page');
AX := $6601;
MSDOS(regs);
if AL = $01 then begin
writeln;
caption2(qindent + 'Active ');
writeln(BX : 5);
caption2(qindent + 'Default');
write(DX : 5)
end else
writeln('N/A');
(* PC Magazine 6:13 p. 181 *)
window(1 + twidth shr 1, 3, twidth, tlength - 2);
caption2('Country code');
writeln(ccode);
caption2('Thousands separator character');
writeln(chr(country[7]));
caption2('Decimal separator character');
writeln(chr(country[9]));
caption2('Data-list separator character');
writeln(chr(country[22]));
caption2('Date format');
xword1 := cbw(country[1], country[0]);
xchar1 := chr(country[11]);
if xword1 = $0000 then
writeln('USA (mm', xchar1, 'dd', xchar1, 'yy)')
else if xword1 = $0001 then begin
writeln('Europe (dd', xchar1, 'mm', xchar1, 'yy)')
end else if xword1 = $0002 then begin
writeln('Japan (yy', xchar1, 'mm', xchar1, 'dd)')
end else
unknown('format', xword1, 4);
caption2(qindent + 'Separator character');
writeln(xchar1);
caption2('Time format');
if (country[17] and $01) = $00 then
write('12')
else
write('24');
writeln('-hour');
caption2(qindent + 'Separator character');
writeln(chr(country[13]));
caption2('Currency format');
writeln;
caption2(qindent + 'Currency symbol string');
i := 2;
xchar1 := chr(country[i]);
while xchar1 > #0 do begin
write(xchar1);
inc(i);
xchar1 := chr(country[i])
end;
writeln;
caption1(qindent + 'Currency symbol ');
if (country[15] and $01) = $00 then
write('precedes')
else
write('follows');
caption1(' value');
writeln;
caption2(qindent + 'Spaces between symbol and value');
writeln(country[15] shr 1 and 1);
caption2(qindent + 'Digits after decimal');
writeln(country[16]);
caption2('Case map call address');
segofs(cbw(country[21], country[20]), cbw(country[19]
, country[18]));
writeln
end;
8 : begin
caption2('Multiplex interrupt ($2F)');
writeln;
muxint('PRINT ', $01);
(* Byte 12:12 p. 176C *)
muxint('ASSIGN ', $06);
(*
** Byte 12:12 p. 176C, Duncan, and many others, all of whom
** mistakenly give AH = $02
*)
(*
muxint('DRIVER.SYS ', $08);
*)
muxint('SHARE ', $10);
(* Byte 12:12 p. 176C *)
(*
muxint('FASTOPEN ', $12);
*)
muxint('NLSFUNC ', $14);
muxint('GRAFTABL ', $B0);
(*
muxint('DISPLAY.SYS ', $B0);
*)
muxint('APPEND ', $B7);
(* Byte 12:12 p. 176C *)
(*
muxint('KEYB ', $B8);
*)
muxint('NETBIOS append ', $87);
muxint('NETBIOS network', $88);
(* Byte 12:12 p. 180 *)
(* PC Tech Journal 3:11 p.104 gives AH = $BB *)
caption2('Environment');
writeln;
topline := 13;
window(1 + lqindent, topline, twidth, tlength - 2);
xword1 := memw[prefixseg : $002C];
i := $0000;
xbyte1 := mem[xword1 : i];
xbool2 := false;
repeat
inc(i);
xbyte2 := mem[xword1 : i];
if xbyte1 > $00 then
write(chr(xbyte1))
else if xbyte2 > $00 then begin
writeln;
pause
end else
xbool2 := true;
xbyte1 := xbyte2
until xbool2
end;
9 : begin
caption1('Device ' + qspace4 + 'Units' + qspace4 + 'Header '
+ qspace4 + 'Attributes ' + qspace4 + 'Strategy '
+ qspace4 + 'Interrupt');
writeln;
if scan(nuldev, devseg, devofs, devofs + $100, xword1) then begin
xword2 := devseg;
xword3 := xword1 - 10;
topline := 4;
window(1, topline, twidth, tlength - 2);
while xword3 < $FFFF do begin
pause;
for i := 0 to 17 do
header[i] := mem[xword2 : xword3 + i];
if header[5] and $80 = 0 then
write(' ', qspace4, header[10] : 5)
else begin
for i := 10 to 17 do
write(showchar(chr(header[i])));
write(qspace4, ' ')
end;
write(qspace4);
segofs(xword2, xword3);
write(qspace4, bin16(cbw(header[5], header[4])), qspace4);
segofs(xword2, cbw(header[7], header[6]));
write(qspace4);
segofs(xword2, cbw(header[9], header[8]));
writeln;
xword2 := cbw(header[3], header[2]);
xword3 := cbw(header[1], header[0])
end
end else
writeln('(can''t find NUL device header)')
(* BIX ms.dos/secrets #1032 *)
end;
10 : begin
caption2('Logical drives');
for xchar1 := 'A' to 'Z' do begin
AH := $0E;
DL := ord(xchar1) - ord('A');
MSDOS(regs);
AH := $19;
MSDOS(regs);
if AL = DL then
drvname(AL)
end;
writeln;
AH := $0E;
DL := currdrv;
MSDOS(regs);
caption2('Diskette drives');
if equip and $0001 = $0001 then
writeln(1 + equip and $00C0 shr 6)
else
writeln(0);
xword1 := intseg[$1E];
xword2 := intofs[$1E];
caption2(qindent + 'Sectors/track');
writeln(mem[xword1 : xword2 + 4]);
caption2(qindent + 'Bytes/sector');
writeln($100 * longint(mem[xword1 : xword2 + 3]));
caption2(qindent + 'On time (ms)');
writeln(125 * mem[xword1 : xword2 + 10]);
caption2(qindent + 'Off time (s)');
writeln(mem[xword1 : xword2 + 2] * tickrate / 1000 : 0 : 1);
caption2(qindent + 'Settling time (ms)');
writeln(mem[xword1 : xword2 + 9]);
caption1(qindent + 'Single drive is now ');
xbyte1 := mem[BIOSseg : $0104];
if xbyte1 <= ord('Z') - ord('A') then begin
drvname(xbyte1);
writeln
end else if xbyte1 = $FF then
writeln('N/A')
else
unknown('status', xbyte1, 2);
(* Byte 12:12 p.178 *)
caption2('Fixed disk controller BIOS source');
showBIOS(HDCBIOS1, HDCBIOS2);
caption2('Current drive and path');
getdir(0, xstring);
writeln(xstring);
caption2(qindent + 'Volume label');
findfirst('\*.*', volumeid, search);
if doserror = 0 then
writeln(search.name)
else
writeln('(none)');
AH := $1B;
MSDOS(regs);
media(mem[DS : BX]);
caption2(qindent + 'Clusters');
writeln(DX);
caption2(qindent + 'Sectors/cluster');
writeln(AL);
caption2(qindent + 'Bytes/sector');
writeln(CX);
caption2(qindent + 'Total space (bytes)');
xlongint := disksize(currdrv + 1);
if xlongint <> -1 then
writeln(xlongint : 8)
else
writeln('(invalid drive)');
caption2(qindent + 'Free space (bytes) ');
xlongint := diskfree(currdrv + 1);
if xlongint <> -1 then
writeln(xlongint : 8)
else
writeln('(invalid drive)')
end;
11 : begin
caption2('BIOS disk parameters');
writeln;
caption1(qindent + 'Type ' + qspace4 + 'Unit #' + qspace4
+ 'Quantity' + qspace4 + 'Heads' + qspace4 + 'Cylinders'
+ qspace4 + 'Sectors/track');
writeln;
topline := 5;
window(1 + lqindent, topline, twidth, tlength - 2);
drvparms($00, 'diskette drive');
drvparms($80, 'fixed disk ')
(* PC Magazine 7:5 p.339 *)
end;
12 : begin
window(1, 3, twidth, tlength - 2);
caption2('DOS disk parameter block');
writeln;
AX := $3200;
DX := $0000;
MSDOS(regs);
if AL = $00 then begin
caption2(qindent + 'Drive');
drvname(mem[DS : BX]);
writeln;
caption2(qindent + 'Unit within driver');
writeln(mem[DS : BX + $01] + 1);
caption2(qindent + 'Bytes/sector');
writeln(memw[DS : BX + $02]);
caption2(qindent + 'Sectors/cluster');
writeln(mem[DS : BX + $04] + 1);
caption2(qindent + 'Cluster to sector shift');
writeln(mem[DS : BX + $05]);
caption2(qindent + 'Reserved (boot) sectors');
writeln(memw[DS : BX + $06]);
caption2(qindent + 'FAT''s');
writeln(mem[DS : BX + $08]);
caption2(qindent + 'Root directory entries');
writeln(memw[DS : BX + $09]);
caption2(qindent
+ 'First data sector');
writeln(memw[DS : BX + $0B]);
caption2(qindent + 'Clusters');
writeln(memw[DS : BX + $0D] - 1);
caption2(qindent + 'Sectors/FAT');
writeln(mem[DS : BX + $0F]);
caption2(qindent + 'Root directory sector');
writeln(memw[DS : BX + $10]);
caption2(qindent + 'Device header');
segofs(memw[DS : BX + $14], memw[DS : BX + $12]);
writeln;
media(mem[DS : BX + $16]);
caption2(qindent + 'Next disk block');
segofs(memw[DS : BX + $1A], memw[DS : BX + $18]);
writeln
end else
writeln('Function 32H error ', hex(AL, 2));
window(1 + twidth shr 1, 3, twidth, tlength - 2);
if bootstat = $0000 then begin
caption1('Boot record of drive ');
drvname(currdrv);
writeln;
caption2(qindent + 'OEM name and version');
for i := $03 to $0A do
write(showchar(chr(bootrec[i])));
writeln;
caption2(qindent + 'Bytes/sector');
writeln(cbw(bootrec[$0C], bootrec[$0B]));
caption2(qindent + 'Sectors/cluster');
writeln(bootrec[$0D]);
caption2(qindent + 'Reserved sectors');
writeln(cbw(bootrec[$0F], bootrec[$0E]));
caption2(qindent + 'FAT''s');
writeln(bootrec[$10]);
caption2(qindent + 'Root directory entries');
writeln(cbw(bootrec[$12], bootrec[$11]));
caption2(qindent + 'Total sectors');
writeln(cbw(bootrec[$14], bootrec[$13]));
media(bootrec[$15]);
caption2(qindent + 'Sectors/FAT');
writeln(cbw(bootrec[$17], bootrec[$16]));
caption2(qindent + 'Sectors/track');
writeln(cbw(bootrec[$19], bootrec[$18]));
caption2(qindent + 'Heads');
writeln(cbw(bootrec[$1B], bootrec[$1A]));
caption2(qindent + 'Hidden sectors');
writeln(cbw(bootrec[$1D], bootrec[$1C]))
end else begin
writeln(qindent, 'Couldn''t read boot record');
write(qindent);
xbyte1 := hi(bootstat);
case xbyte1 of
$80 : writeln('Attachment failed to respond');
$40 : writeln('Seek operation failed');
$20 : writeln('Controller failed');
$10 : writeln('Data error (bad CRC)');
$08 : writeln('DMA failure');
$04 : writeln('Sector not found');
$03 : writeln('Write-protect fault');
$02 : writeln('Bad address mark');
$01 : writeln('Bad command');
$00 :
else
unknown('error', xbyte1, 2)
end;
write(qindent);
xbyte1 := lo(bootstat);
case xbyte1 of
$00 : writeln('Write-protect error');
$01 : writeln('Unknown unit');
$02 : writeln('Drive not ready');
$03 : writeln('Unknown command');
$04 : writeln('Data error (bad CRC)');
$05 : writeln('Bad request structure length');
$06 : writeln('Seek error');
$07 : writeln('Unknown media type');
$08 : writeln('Sector not found');
$09 : writeln('Printer out of paper');
$0A : writeln('Write fault');
$0B : writeln('Read fault');
$0C : writeln('General failure')
else
unknown('error', xbyte1, 2)
end
end;
end
end;
window(1, 1, twidth, tlength);
gotoxy(x2, tlength);
xbool2 := false;
repeat
repeat
until keypressed;
xchar1 := readkey;
if keypressed then
xchar2 := readkey
else
xchar2 := #0;
if (xchar1 = #27) and (xchar2 = #0) then begin
xbool2 := true;
xbool1 := true
end else if (xchar1 = #0) and (xchar2 = #71) and (pg > 1) then begin
xbool2 := true;
pg := 1
end else if (xchar1 = #0) and (xchar2 = #73) and (pg > 1) then begin
xbool2 := true;
dec(pg)
end else if (xchar1 = #0) and (xchar2 = #79) and (pg < pgmax) then
begin
xbool2 := true;
pg := pgmax
end else if (xchar1 = #0) and (xchar2 = #81) and (pg < pgmax) then
begin
xbool2 := true;
inc(pg)
end else begin
sound(220);
delay(100);
nosound
end
until xbool2
until xbool1;
textattr := attrsave;
clrscr
end else begin
writeln;
writeln('SYSID requires DOS version 3.0 or later');
write('Your DOS version is ');
showvers
end
end
end.